home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / dired-cwd.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  3.4 KB  |  87 lines
  1. ;;;; dired-cwd.el - Fix a command's current working directory in Tree Dired.
  2.  
  3. (defconst dired-cwd-version (substring "!Revision: 1.2 !" 11 -2)
  4.   "!Id: dired-cwd.el,v 1.2 1991/10/08 15:31:28 sk RelBeta !")
  5.  
  6. ;; Copyright (C) 1991 by Sebastian Kremer <sk@thp.uni-koeln.de>
  7.  
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 1, or (at your option)
  11. ;; any later version.
  12. ;;
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17. ;;
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program; if not, write to the Free Software
  20. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  23. ;;    LCD Archive Entry:
  24. ;;    dired-cwd|Sebastian Kremer|sk@thp.uni-koeln.de
  25. ;;    |Fix a command's current working directory in Tree Dired. 
  26. ;;    |Date: 1991/10/08 15:31:28 |Revision: 1.2 |
  27.  
  28. ;; INSTALLATION ======================================================
  29. ;; 
  30. ;; Put this file into your load-path and the following in your ~/.emacs:
  31. ;; 
  32. ;;   (autoload 'dired-cwd-make-magic "dired-cwd")
  33. ;;
  34. ;; You have to load dired-x.el in your dired-load-hook to define
  35. ;; function default-directory, or you will not benefit from this
  36. ;; package: as long as function default-directory is not defined, the
  37. ;; functions wrapped by dired-cwd-make-magic will behave as before.
  38.  
  39. ;; EXAMPLE USAGE ======================================================
  40. ;;
  41. ;; How to fix M-x compile (and grep) to know about Tree Dired's multiple
  42. ;; working directories by putting the following lines into your ~/.emacs:
  43. ;; 
  44. ;;    (require 'compile)
  45. ;;    (dired-cwd-make-magic 'compile1)
  46. ;;
  47. ;; After that, a compilation or grep started in a subdirectory in a
  48. ;; Dired buffer will have that subdirectory as working directory.
  49. ;;
  50. ;; Note you must require 'compile as function compile1 is redefined.
  51. ;; You could use a load hook instead by adding the line
  52. ;;
  53. ;;     (run-hooks 'compile-load-hook)
  54. ;;     
  55. ;; at the end of compile.el and setting
  56. ;;
  57. ;;    (setq compile-load-hook '(lambda () (dired-cwd-make-magic 'compile1)))
  58. ;;
  59. ;; in your ~/.emacs.
  60.  
  61.  
  62. ;;;###autoload
  63. (defun dired-cwd-make-magic (function)
  64.   "Modify COMMAND so that it's working directory is the current dired directory.
  65. This works by binding `default-directory' to `(default-directory)'s value.
  66. See also function `default-directory'."
  67.   (interactive "aMake work with tree dired (function): ")
  68.   (if (commandp function)
  69.       (error "Cannot make interactive functions work for tree dired"))
  70.   (let ((save-name (intern (concat "dired-cwd-wrap-real-" (symbol-name
  71.                                function))))
  72.     new-function)
  73.     (setq new-function
  74.       (` (lambda (&rest dired-cwd-args)
  75.            ;; Name our formal args unique to avoid shadowing
  76.            ;; through dynamic scope.
  77.            (let ((default-directory
  78.                (if (fboundp 'default-directory)
  79.                ;; This is defined in dired-x.el, but dired
  80.                ;; may not yet be loaded.
  81.                (default-directory)
  82.              default-directory)))
  83.          (apply 'funcall (quote (, save-name)) dired-cwd-args)))))
  84.     (or (fboundp save-name)
  85.     (fset save-name (symbol-function function)))
  86.     (fset function new-function)))
  87.